home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr22 / rdstderr.zip / RDSTDERR.PAS < prev   
Pascal/Delphi Source File  |  1993-05-01  |  3KB  |  100 lines
  1. program RdStdErr;
  2. {  Redirects STDERR (standard error device) to a file }
  3. {    R.J. Bartlett   21 Feb 88                        }
  4.  
  5. {$R-,S-,I+,D+,T-,F-,V-,B-,N-,L+ }
  6. {$M 8192,0,0}
  7.  
  8. uses
  9.    dos;
  10. const
  11.    StdErr = 2;
  12. var
  13.    regs         : registers;
  14.    CmdToExecute : string[255];
  15.    FileHandle   : word;
  16.    W            : word;
  17.    Dummy        : boolean;
  18.  
  19.  
  20. procedure WrtHalt(ErrMsg : string);
  21. begin
  22.    writeln;
  23.    writeln('RdStdErr - ',ErrMsg);
  24.    halt(255);
  25. end;
  26.  
  27.  
  28. function FileHandleOpen(FileName : string; var fh : word) : boolean;
  29. begin
  30.    FileName := FileName + #0;    { make filename an ASCIIZ string }
  31.    regs.ax := $3c00;             { create file handle function call }
  32.    regs.ds := seg(FileName[1]);
  33.    regs.dx := ofs(FileName[1]);
  34.    regs.cx := 0;
  35.    msdos(regs);
  36.    fh := regs.ax;
  37.    FileHandleOpen := (regs.flags and fcarry) = 0;
  38. end;
  39.  
  40.  
  41. function FileHandleDuplicate(fh : word) : boolean;
  42. begin
  43.    regs.ax := $4600;            { force duplicate of file handle }
  44.    regs.bx := fh;
  45.    regs.cx := StdErr;
  46.    msdos(regs);
  47.    FileHandleDuplicate := (regs.flags and fcarry) = 0;
  48. end;
  49.  
  50.  
  51. function FileHandleClose(fh : word) : boolean;
  52. begin
  53.    regs.ax := $3e00;            { close file FileHandle }
  54.    regs.bx := fh;
  55.    msdos(regs);
  56.    FileHandleClose := (regs.flags and fcarry) = 0;
  57. end;
  58.  
  59.  
  60. procedure Run(CmdToRun : string);
  61. var
  62.    EnvSeg     : word;
  63.    ComSpecStr : string[80];
  64. begin
  65.    EnvSeg:= memw[PrefixSeg:$2c];
  66.    move(mem[EnvSeg : 0], ComSpecStr[1], 80);  { move env to a string }
  67.    ComSpecStr[0] := #80;
  68.    ComSpecStr[0] := char(pos(#0, ComSpecStr) - 1);
  69.    delete(ComSpecStr, 1, pos('COMSPEC=', ComSpecStr) + 7);
  70.    exec(ComSpecStr, '/c ' + CmdToRun);
  71. end;
  72.  
  73.  
  74. begin
  75.    if ParamCount < 2 then
  76.    begin
  77.       writeln(' Usage -> RDSTDERR FileName Cmd ');
  78.       writeln('            FileName = name of file to send STDERR output to ');
  79.       writeln('            Cmd      = command to execute ');
  80.       halt(255);
  81.    end;
  82.    CmdToExecute := ParamStr(2);
  83.    for W:= 3 to ParamCount do CmdToExecute:= CmdToExecute + ' ' + ParamStr(W);
  84.    if not FileHandleOpen(ParamStr(1), FileHandle) then
  85.       WrtHalt('File FileHandle open error')
  86.    else
  87.    begin
  88.       if not FileHandleDuplicate(FileHandle) then
  89.       begin
  90.          Dummy := FileHandleClose(FileHandle);
  91.          WrtHalt('cannot force duplicate of StdErr');
  92.       end
  93.       else
  94.       begin
  95.          Run(CmdToExecute);
  96.          if not FileHandleClose(FileHandle) then
  97.             WrtHalt('File FileHandle close error');
  98.       end;
  99.    end;
  100. end.